home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ARK.ARJ / FM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-07  |  30.2 KB  |  1,345 lines
  1. (****************************************************************************
  2.  
  3. (c) 1992 by Michelangelo Policarpo per Sound Blaster Digest Italia
  4.  
  5. Unit FM per la gestione diretta della sezione FM di una qualsiasi scheda
  6. AdLib compatibile.
  7.  
  8. Versione 1.0        7/10/92       Primo rilascio al Pubblico Dominio
  9.  
  10. L'autore ha posto ogni cura (e tempo) nella realizzazione di queste routines,
  11. testandole sotto svariate condizioni di uso.
  12.  
  13. A causa della varieta` delle condizioni e dell' hardware con cui queste pos-
  14. sono essere utilizzate, non e` pero` possibile offrire alcuna garanzia sul
  15. loro corretto funzionamento.
  16.  
  17. Chi usa questo pacchetto (o direttamente derivato) accetta implicitamente
  18. tutte le le clausole qui riportate :
  19. 1.  L' utente si assume ogni responsabilita` per gli eventuali danni che le
  20.     routines possono provocare, soprattutto a causa di un uso improprio del
  21.     prodotto.
  22. 2.  L' utente deve riportare nella documentazione di accompagnamento del
  23.     software da lui prodotto il copyright sopra riportato o equivalente nota
  24.     di utilizzo di questo pacchetto.
  25.  
  26. QUESTO PACCHETTO VIENE RILASCIATO AL PUBBLICO DOMINIO E PERTANTO DEVE ESSERE
  27. DISTRIBUITO LIBERAMENTE E GRATUITAMENTE. TALE PACCHETTO PUO` ANCHE ESSERE
  28. MODIFICATO PURCHE` RIMANGA INTATTA LA NOTA DI COPYRIGHT E QUESTA PARTE DI
  29. COMMENTO.
  30.  
  31. ****************************************************************************)
  32.  
  33. unit FM;
  34.  
  35. interface
  36.  
  37. const
  38.   Melodic = 0;
  39.   Rhythmic = 1;
  40.   Undefined = $FF;
  41.  
  42.   OFF = false;
  43.   ON = true;
  44.  
  45. const
  46.   FMErrorMsg : array[1..10] of string[31] =
  47.     ('AdLib or SB card not present',
  48.      'Invalid note',
  49.      'Invalid voice',
  50.      '',
  51.      '',
  52.      '',
  53.      '',
  54.      '',
  55.      '',
  56.      '' );
  57.  
  58. {.BNK entry file structure}
  59.  
  60. type
  61.   Operator = record
  62.     KSL,       FreqMult,  Feedback,  Attack,
  63.     SustLevel, EG,        Decay,     Release,
  64.     Output,    AM,        Vib,       KSR,       FM : byte
  65.   end;
  66.  
  67. type
  68.   InsDataPtr = ^InsData;
  69.   InsData = record
  70.     Mode, PercVoice : byte;
  71.     Op0, Op1 : Operator;
  72.     Wave0, Wave1 : byte
  73.   end;
  74.  
  75. {.INS file structure}
  76.  
  77. type
  78.   OPER = record
  79.     KSL,       FreqMult,  Feedback,  Attack,
  80.     SustLevel, EG,        Decay,     Release,
  81.     Output,    AM,        Vib,       KSR,       FM : word
  82.   end;
  83.  
  84.   INS = record
  85.     Mode : byte;
  86.     PercVoice : byte;
  87.     OPER0,OPER1 : OPER;
  88.   end;
  89.  
  90.   INSEXT = record
  91.     INSBase : INS;
  92.     Wave0,Wave1 : word;
  93.     Pad : array[1..10] of word;
  94.     One : word;
  95.   end;
  96.  
  97. var
  98.   FMError : integer;
  99.   CurrentFMMode : byte;
  100.   BaseReg : word;
  101.   AdLibInstalled : boolean;
  102.   WaveFormEnabled, CSMModeEnabled, KBDSplitEnabled, AMDepthEnabled,
  103.   VIBDepthEnabled : boolean;
  104.  
  105. {Global variables}
  106.  
  107. procedure SetMelRhythm(State : boolean);
  108.  
  109. procedure SetWaveForm (State : boolean);
  110. procedure SetCSMMode  (State : boolean);
  111. procedure SetKBDSplit (State : boolean);
  112. procedure SetAMDepth  (State : boolean);
  113. procedure SetVIBDepth (State : boolean);
  114.  
  115. {Operator cells parameters}
  116.           {For any}
  117. procedure SetAM          (Ofs,Data : byte);
  118. procedure SetVib         (Ofs,Data : byte);
  119. procedure SetEG          (Ofs,Data : byte);
  120. procedure SetKSR         (Ofs,Data : byte);
  121. procedure SetFreqMult    (Ofs,Data : byte);
  122. procedure SetKSL         (Ofs,Data : byte);
  123. procedure SetOutput      (Ofs,Data : byte);
  124. procedure SetAttack      (Ofs,Data : byte);
  125. procedure SetDecay       (Ofs,Data : byte);
  126. procedure SetSustLevel   (Ofs,Data : byte);
  127. procedure SetRelease     (Ofs,Data : byte);
  128. procedure SetWaveSel     (Ofs,Data : byte);
  129.           {Only for modulator}
  130. procedure SetFeedback    (Ofs,Data : byte);
  131. procedure SetFM          (Ofs,Data : byte);
  132.  
  133. {For direct register access, CMF}
  134.  
  135. function  ModOfs(channel : byte) : byte;
  136. function  CarOfs(channel : byte) : byte;
  137.  
  138. procedure SetSC(Ofs, Data : byte);
  139. procedure SetSO(Ofs, Data : byte);
  140. procedure SetAD(Ofs, Data : byte);
  141. procedure SetSR(Ofs, Data : byte);
  142. procedure SetWS(Ofs, Data : byte);
  143. procedure SetFC(Ofs, Data : byte);
  144.  
  145. {General routines}
  146.  
  147. procedure SetFMMode     (FMMode : byte);
  148.  
  149. procedure AssignVoice   (Voice : byte; Ins : InsData);
  150.  
  151. procedure AllKeyOff;
  152.  
  153. procedure KeyOn         (Voice, Note : byte);
  154. procedure KeyOff        (Voice : byte);
  155. procedure QuitVoices;
  156. procedure QuitVoice     (Voice: byte);
  157. procedure ResetVoice    (Voice: byte);
  158. procedure ResetSynth;
  159.  
  160. function  FMStatus      (voice : byte) : InsDataPtr;
  161. procedure FMInit(Base : word);
  162.  
  163. function  FindBasePort : boolean;
  164. function  FindSBPBasePort : word;
  165. function  IsAdLib : boolean;
  166.  
  167. implementation
  168.  
  169. type
  170.   InsArray = array[0..29] of byte;
  171.  
  172. const
  173.   FNumbers :
  174.     array[0..11] of word = (363,385,408,432,458,485,514,544,577,611,647,686);
  175.  
  176. {Offsets in registers array}
  177.  
  178.   M_OpCell : array[1..9,0..1] of byte =
  179.     (($00,$03),($01,$04),($02,$05),
  180.     ($08,$0B),($09,$0C),($0A,$0D),
  181.     ($10,$13),($11,$14),($12,$15));
  182.  
  183.   R_OpCell : array[1..11,0..1] of byte =
  184.     (($00,$03),($01,$04),($02,$05),
  185.     ($08,$0B),($09,$0C),($0A,$0D),
  186.     ($10,$13),($14,$FF),($12,$FF),
  187.     ($15,$FF),($11,$FF));
  188.  
  189.   Octave : array[0..95] of byte =
  190.     (0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,
  191.     2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,
  192.     4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,
  193.     6,6,6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,7,7);
  194.  
  195.   Semitone : array[0..95] of byte =
  196.     (0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11,
  197.     0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11,
  198.     0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11,
  199.     0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11);
  200.  
  201.                      {M/PV-1}                   {Op0}             {v--caution!}         {Op1}                  {WS}
  202.  
  203.   Piano1 : InsArray = ( 0,00,  1, 1, 3,15, 5, 0, 1, 3,15, 0, 0, 0, 0,  0, 1, 0,13, 7, 0, 2, 4,16, 0, 0, 1, 0,  0,0);
  204.   BDrum1 : InsArray = ( 1,06,  0, 0, 0,10, 4, 0, 8,12,11, 0, 0, 0, 0,  0, 0,47,13, 4, 0, 6,15,16, 0, 0, 0, 1,  0,0);
  205.   Snare1 : InsArray = ( 1,07,  0,12, 0,15,11, 0, 8, 5,16, 0, 0, 0, 1,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,  0,0);
  206.   Tom1   : InsArray = ( 1,08,  0, 4, 0,15,11, 0, 7, 5,16, 0, 0, 0, 1,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,  0,0);
  207.   Cymbal1: InsArray = ( 1,09,  0, 1, 0,15,11, 0, 5, 5,16, 0, 0, 0, 1,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,  0,0);
  208.   HiHat1 : InsArray = ( 1,10,  0, 1, 0,15,11, 0, 7, 5,16, 0, 0, 0, 1,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,  0,0);
  209.  
  210. const
  211.  
  212. {Register offsets}                                        {Range}
  213.  
  214. {First group : general}
  215.  
  216.   R_TEST   : byte = $01;  {Test}                         {001h}
  217.   R_TIM1   : byte = $02;  {Timer 1}                      {002h}
  218.   R_TIM2   : byte = $03;  {Timer 2}                      {003h}
  219.   R_TIMC   : byte = $04;  {Timer Control}                {004h}
  220.   R_CSMK   : byte = $08;  {CSM Mode/Keyboard Split}      {008h}
  221.   R_AVR    : byte = $BD;  {AM VIB-Depth/Rhythm}          {0BDh}
  222.  
  223. {Second group : for each operator cell}
  224.  
  225.   R_AVEKM  : byte = $20;  {AM/VIB/EG/KSR/MULTIPLE}       {020h-035h}
  226.   R_KTL    : byte = $40;  {KSL/Total Level}              {040h-055h}
  227.   R_ARDR   : byte = $60;  {Attack Rate/Decay Rate}       {060h-075h}
  228.   R_SLRR   : byte = $80;  {Sustain Level/Release Rate}   {080h-095h}
  229.   R_WS     : byte = $E0;  {Wave Select}                  {0E0h-0F5h}
  230.  
  231. {Third group : for each channel}
  232.  
  233.   R_FNUM   : byte = $A0;  {F-Number Low bits}            {0A0h-0A8h}
  234.   R_BLK    : byte = $B0;  {F-Number High bits}           {0B0h-0B8h}
  235.   R_FBC    : byte = $C0;  {Feedback/Connection}          {0C0h-0C8h}
  236.  
  237. var
  238.   FMRegisters : array[0..$FF] of byte;
  239.   MelRhythm : boolean;
  240.  
  241.   Install : boolean;
  242.   TmpInsData : InsData;
  243.  
  244. procedure OutCmd; assembler;            {al = Address; ah = Data}
  245.  
  246. asm {OutCmd}
  247.   push  ax
  248.   push  dx
  249.   push  bx
  250.   xor   bx,bx
  251.   mov   bl,al
  252.   mov   byte ptr FMRegisters[bx],ah     {UpDate buffer area}
  253.   pop   bx
  254.   cmp   Install,true
  255.   je    @GoOn
  256.   cmp   AdlibInstalled,true
  257.   jne   @Exit
  258. @GoOn:
  259.   mov   dx,BaseReg
  260.   out   dx,al
  261.   in    al, dx
  262.   in    al, dx
  263.   in    al, dx
  264.   in    al, dx
  265.   in    al, dx
  266.   in    al, dx
  267.  
  268.   inc   dx
  269.   mov   al,ah
  270.   out   dx,al
  271.   in    al, dx
  272.   in    al, dx
  273.   in    al, dx
  274.   in    al, dx
  275.   in    al, dx
  276.   in    al, dx
  277.   in    al, dx
  278.   in    al, dx
  279.   in    al, dx
  280.   in    al, dx
  281.  
  282.   in    al, dx
  283.   in    al, dx
  284.   in    al, dx
  285.   in    al, dx
  286.   in    al, dx
  287.   in    al, dx
  288.   in    al, dx
  289.   in    al, dx
  290.   in    al, dx
  291.   in    al, dx
  292.  
  293.   in    al, dx
  294.   in    al, dx
  295.   in    al, dx
  296.   in    al, dx
  297.   in    al, dx
  298.   in    al, dx
  299.   in    al, dx
  300.   in    al, dx
  301.   in    al, dx
  302.   in    al, dx
  303.  
  304.   in    al, dx
  305.   in    al, dx
  306.   in    al, dx
  307.   in    al, dx
  308.   in    al, dx
  309. @Exit:
  310.   pop   dx
  311.   pop   ax
  312. end; {OutCmd}
  313.  
  314. procedure SetAM(Ofs,Data : byte); assembler;
  315.  
  316. asm {SetAM}
  317.   mov   al,Data
  318.   and   al,00000001b
  319.   ror   al,1
  320.   xor   bx,bx
  321.   mov   bl,Ofs
  322.   add   bl,20h
  323.   mov   ah,byte ptr FMRegisters[bx]
  324.   and   ah,01111111b
  325.   or    ah,al
  326.   mov   al,bl
  327.   call  OutCmd
  328. end; {SetAM}
  329.  
  330. procedure SetVib(Ofs,Data : byte); assembler;
  331.  
  332. asm {SetVib}
  333.   mov   al,Data
  334.   and   al,00000001b
  335.   ror   al,1
  336.   ror   al,1
  337.   xor   bx,bx
  338.   mov   bl,Ofs
  339.   add   bx,20h
  340.   mov   ah,byte ptr FMRegisters[bx]
  341.   and   ah,10111111b
  342.   or    ah,al
  343.   mov   al,bl
  344.   call  OutCmd
  345. end; {SetVib}
  346.  
  347. procedure SetEG(Ofs,Data : byte); assembler;
  348.  
  349. asm {SetEG}
  350.   mov   al,Data
  351.   and   al,00000001b
  352.   ror   al,1
  353.   ror   al,1
  354.   ror   al,1
  355.   xor   bx,bx
  356.   mov   bl,Ofs
  357.   add   bx,20h
  358.   mov   ah,byte ptr FMRegisters[bx]
  359.   and   ah,11011111b
  360.   or    ah,al
  361.   mov   al,bl
  362.   call  OutCmd
  363. end; {SetEG}
  364.  
  365. procedure SetKSR(Ofs,Data : byte); assembler;
  366.  
  367. asm {SetKSR}
  368.   mov   al,Data
  369.   and   al,00000001b
  370.   ror   al,1
  371.   ror   al,1
  372.   ror   al,1
  373.   ror   al,1
  374.   xor   bx,bx
  375.   mov   bl,Ofs
  376.   add   bx,20h
  377.   mov   ah,byte ptr FMRegisters[bx]
  378.   and   ah,11101111b
  379.   or    ah,al
  380.   mov   al,bl
  381.   call  OutCmd
  382. end; {SetKSR}
  383.  
  384. procedure SetFreqMult(Ofs,Data : byte); assembler;
  385.  
  386. asm {SetFreqMult}
  387.   mov   al,Data
  388.   and   al,00001111b
  389.   xor   bx,bx
  390.   mov   bl,Ofs
  391.   add   bx,20h
  392.   mov   ah,byte ptr FMRegisters[bx]
  393.   and   ah,11110000b
  394.   or    ah,al
  395.   mov   al,bl
  396.   call  OutCmd
  397. end; {SetFreqMult}
  398.  
  399. procedure SetKSL(Ofs,Data : byte); assembler;
  400.  
  401. asm {SetKSL}
  402.   mov   al,Data
  403.   and   al,00000011b
  404.   ror   al,1
  405.   ror   al,1
  406.   xor   bx,bx
  407.   mov   bl,Ofs
  408.   add   bx,40h
  409.   mov   ah,byte ptr FMRegisters[bx]
  410.   and   ah,00111111b
  411.   or    ah,al
  412.   mov   al,bl
  413.   call  OutCmd
  414. end; {SetKSL}
  415.  
  416. procedure SetOutput(Ofs,Data : byte); assembler;
  417.  
  418. asm {SetOutput}
  419.   mov   al,Data
  420.   and   al,00111111b
  421.   xor   bx,bx
  422.   mov   bl,Ofs
  423.   add   bx,40h
  424.   mov   ah,byte ptr FMRegisters[bx]
  425.   and   ah,11000000b
  426.   or    ah,al
  427.   mov   al,bl
  428.   call  OutCmd
  429. end; {SetOutput}
  430.  
  431. procedure SetAttack(Ofs,Data : byte); assembler;
  432.  
  433. asm {SetAttack}
  434.   mov   al,Data
  435.   and   al,00001111b
  436.   ror   al,1
  437.   ror   al,1
  438.   ror   al,1
  439.   ror   al,1
  440.   xor   bx,bx
  441.   mov   bl,Ofs
  442.   add   bx,60h
  443.   mov   ah,byte ptr FMRegisters[bx]
  444.   and   ah,00001111b
  445.   or    ah,al
  446.   mov   al,bl
  447.   call  OutCmd
  448. end; {SetAttack}
  449.  
  450. procedure SetDecay(Ofs,Data : byte); assembler;
  451.  
  452. asm {SetDecay}
  453.   mov   al,Data
  454.   and   al,00001111b
  455.   xor   bx,bx
  456.   mov   bl,Ofs
  457.   add   bx,60h
  458.   mov   ah,byte ptr FMRegisters[bx]
  459.   and   ah,11110000b
  460.   or    ah,al
  461.   mov   al,bl
  462.   call  OutCmd
  463. end; {SetDecay}
  464.  
  465. procedure SetSustLevel(Ofs,Data : byte); assembler;
  466.  
  467. asm {SetSustLevel}
  468.   mov   al,Data
  469.   and   al,00001111b
  470.   ror   al,1
  471.   ror   al,1
  472.   ror   al,1
  473.   ror   al,1
  474.   xor   bx,bx
  475.   mov   bl,Ofs
  476.   add   bx,80h
  477.   mov   ah,byte ptr FMRegisters[bx]
  478.   and   ah,00001111b
  479.   or    ah,al
  480.   mov   al,bl
  481.   call  OutCmd
  482. end; {SetSustLevel}
  483.  
  484. procedure SetRelease(Ofs,Data : byte); assembler;
  485.  
  486. asm {SetRelease}
  487.   mov   al,Data
  488.   and   al,00001111b
  489.   xor   bx,bx
  490.   mov   bl,Ofs
  491.   add   bx,80h
  492.   mov   ah,byte ptr FMRegisters[bx]
  493.   and   ah,11110000b
  494.   or    ah,al
  495.   mov   al,bl
  496.   call  OutCmd
  497. end; {SetRelease}
  498.  
  499. procedure SetWaveSel(Ofs,Data : byte); assembler;
  500.  
  501. asm {SetWaveSel}
  502.   mov   al,Data
  503.   and   al,00000011b
  504.   xor   bx,bx
  505.   mov   bl,Ofs
  506.   add   bx,0E0h
  507.   mov   ah,byte ptr FMRegisters[bx]
  508.   and   ah,11111100b
  509.   or    ah,al
  510.   mov   al,bl
  511.   call  OutCmd
  512. end; {SetWaveSel}
  513.  
  514. procedure SetFeedback(Ofs,Data : byte); assembler;
  515.  
  516. asm {SetFeedback}
  517.   mov   al,Data
  518.   and   al,00000111b
  519.   shl   al,1
  520.   xor   bx,bx
  521.   mov   bl,Ofs
  522.   add   bx,0C0h
  523.   mov   ah,byte ptr FMRegisters[bx]
  524.   and   ah,11110001b
  525.   or    ah,al
  526.   mov   al,bl
  527.   call  OutCmd
  528. end; {SetFeedback}
  529.  
  530. procedure SetFM(Ofs,Data : byte); assembler;
  531.  
  532. asm {SetFM}
  533.   mov   al,Data
  534.   and   al,00000001b
  535.   xor   bx,bx
  536.   mov   bl,Ofs
  537.   add   bx,0C0h
  538.   mov   ah,byte ptr FMRegisters[bx]
  539.   and   ah,11111110b
  540.   or    ah,al
  541.   mov   al,bl
  542.   call  OutCmd
  543. end; {SetFM}
  544.  
  545. procedure SetOpCellParameters(Offset : byte; Op : Operator; WaveSel : byte);
  546.  
  547. begin {SetOpCellParameters}
  548.   with Op do
  549.     begin
  550.       SetAM       (Offset,AM);
  551.       SetVib      (Offset,Vib);
  552.       SetEG       (Offset,EG);
  553.       SetKSR      (Offset,KSR);
  554.       SetFreqMult (Offset,FreqMult);
  555.       SetKSL      (Offset,KSL);
  556.       SetOutput   (Offset,Output);
  557.       SetAttack   (Offset,Attack);
  558.       SetDecay    (Offset,Decay);
  559.       SetSustLevel(Offset,SustLevel);
  560.       SetRelease  (Offset,Release);
  561.       SetWaveSel  (Offset,WaveSel)
  562.     end
  563. end; {SetOpCellParameters}
  564.  
  565. procedure AssignVoice(Voice : byte; Ins : InsData);
  566.  
  567. begin {AssignVoice}
  568.   if Voice<=0 then
  569.      begin
  570.        FMError := 3;
  571.       Exit
  572.     end;
  573.   if (CurrentFMMode=Melodic) then
  574.     begin
  575.       if Voice>9 then
  576.         begin
  577.           FMError := 3;
  578.           Exit
  579.         end;
  580.       SetOpCellParameters(M_OpCell[Voice][0],Ins.OP0,Ins.Wave0);
  581.       with Ins.OP0 do
  582.         begin
  583.           SetFeedBack(Voice-1,FeedBack);
  584.           SetFM(Voice-1,FM);
  585.         end;
  586.       SetOpCellParameters(M_OpCell[Voice][1],Ins.OP1,Ins.Wave1);
  587.     end
  588.   else    {Rhythmic}
  589.     begin
  590.       if Voice>11 then
  591.         begin
  592.           FMError := 3;
  593.           Exit
  594.         end;
  595.       SetOpCellParameters(R_OpCell[Voice][0],Ins.OP0,Ins.Wave0);
  596.       with Ins.OP0 do
  597.         begin
  598.           SetFeedBack(Voice-1,FeedBack);
  599.           if Voice<=9 then
  600.             SetFM(Voice-1,FM);
  601.         end;
  602.       if Voice<=7 then
  603.         SetOpCellParameters(R_OpCell[Voice][1],Ins.OP1,Ins.Wave1);
  604.     end
  605. end; {AssignVoice}
  606.  
  607. procedure KeyOn(Voice, Note : byte); assembler;
  608.  
  609. {Note is the MIDI value for the note to play: note in [0..$5F]}
  610.  
  611. asm {KeyOn}
  612.   xor   bx,bx
  613.   mov   bl,Note
  614.   cmp   bl,5Fh
  615.   jbe   @NoteGood
  616.   mov   FMError,2                    {Invalid note}
  617.   jmp   @Done
  618.  
  619. @NoteGood:
  620.   push  bx
  621.   mov   bl,byte ptr Semitone[bx]        {bl = Semitone}
  622.   shl   bx,1
  623.   mov   bx,word ptr FNumbers[bx]        
  624.  
  625.   xchg  ax,bx                           {ax = FNumber}
  626.  
  627.   pop   bx
  628.   mov   bl,byte ptr Octave[bx]          {bl = Octave}
  629.  
  630.   and   bl,07h;
  631.   shl   bl,1
  632.   shl   bl,1
  633.  
  634.   or    ah,bl                           {ax = Octave|F-Number}
  635.  
  636.   mov   dl,Voice
  637.   cmp   dl,11
  638.   ja    @BadVoice
  639.   cmp   dl,0
  640.   jle   @BadVoice
  641.  
  642.   cmp   dl,6                            {Exclude Bass Drum}
  643.   jle   @Melodic
  644.   cmp   CurrentFMMode,1                 {is Rhythmic?}
  645.   jne   @Melodic                        {no, jump}
  646.  
  647. {@Rhythmic:}
  648.  
  649.   cmp   MelRhythm,1                     {is Rhythmic section melodic-enabled?}
  650.   jne   @GoOn                           {no: skip frequency control}
  651.  
  652.   cmp   dl,7                            {is less than a Bass drum?}
  653.   jl    @GoOn
  654.   cmp   dl,11                           {is more than Tom-Tom?}
  655.   jg    @GoOn
  656.  
  657.   xchg  ax,bx
  658.   mov   al,dl
  659.   dec   al                              {al=offset}
  660.   add   al,0A0h                         {register}
  661.   mov   ah,bl                           {data : Lo(F-Number)}
  662.   call  OutCmd
  663.   add   al,010h                         {register}
  664.   mov   ah,bh                           {data : KeyOn|Block|Hi(F-Number)}
  665.   call  OutCmd
  666.  
  667. @GoOn:
  668.   mov   cx,11
  669.   sub   cl,Voice
  670.  
  671.   mov   al,01h
  672.   rol   al,cl
  673.   mov   ah,byte ptr FMRegisters[0BDh]
  674.   or    ah,al
  675.   mov   al,0BDh
  676.   call  OutCmd
  677.  
  678.   jmp   @Done
  679. @Melodic:
  680.  
  681.   cmp   dl,9
  682.   jg    @BadVoice
  683.  
  684.   or    ah,20h                          {add KeyOn}
  685.  
  686.   xchg  ax,bx
  687.   mov   al,dl
  688.   dec   al                              {al=offset}
  689.   add   al,0A0h                         {register}
  690.   mov   ah,bl                           {data : Lo(F-Number)}
  691.   call  OutCmd
  692.   add   al,010h                         {register}
  693.   mov   ah,bh                           {data : KeyOn|Block|Hi(F-Number)}
  694.   call  OutCmd
  695.   jmp   @Done
  696.  
  697. @BadVoice:
  698.   mov    FMError,3
  699. @Done:
  700. end; {KeyOn}
  701.  
  702. procedure KeyOff(Voice : byte); assembler;
  703.  
  704. asm {KeyOff}
  705.   push  cx
  706.   mov   al,Voice
  707.   cmp   al,6
  708.   jle   @Melodic
  709.   test  CurrentFMMode,1
  710.   jz    @Melodic
  711.   mov   cx,11
  712.   sub   cl,al
  713.   js    @Error
  714.   mov   al,0FEh
  715.   rol   al,cl
  716.   mov   ah,byte ptr FMRegisters[0BDh]
  717.   and   ah,al
  718.   mov   al,0BDh
  719.   call  OutCmd
  720.   jmp   @Done
  721. @Melodic:
  722.   cmp   al,9
  723.   jg    @Error
  724.   dec   al
  725.   cmp   al,0
  726.   jl    @Error
  727.   add   al,0B0h
  728.   xor   bx,bx
  729.   mov   bl,al
  730.   mov   ah,byte ptr FMRegisters[bx]
  731.   and   ah,11011111b
  732.   call  OutCmd
  733.   jmp   @Done
  734. @Error:
  735.   mov   FMError,3
  736. @Done:
  737.   pop   cx
  738. end; {KeyOff}
  739.  
  740. procedure QuitVoice(Voice : byte);
  741.  
  742. begin {QuitVoice}
  743.   SetRelease(R_OpCell[Voice][0],15);
  744.   SetRelease(R_OpCell[Voice][1],15);
  745.   KeyOff(Voice);
  746. end; {QuitVoice}
  747.  
  748. procedure QuitVoices; assembler;
  749.  
  750. asm {QuitVoices}
  751.  
  752.   mov   cx,3
  753.   mov   ax,40h
  754.  
  755. @NextN:
  756.  
  757.   push  cx
  758.   mov   cx,3
  759.  
  760. @NextM:
  761.   push  cx
  762.   mov   ah,7Fh
  763.   call  OutCmd
  764.   add   al,40h
  765.   mov   ah,5Fh
  766.   call  OutCmd
  767.   sub   al,40h
  768.   add   al,3
  769.   mov   ah,3Fh
  770.   call  OutCmd
  771.   add   al,40h
  772.   mov   ah,7Fh
  773.   call  OutCmd
  774.   sub   ax,40h
  775.   sub   ax,2
  776.   pop   cx
  777.   loop  @NextM
  778.  
  779.   add   ax,5
  780.   pop   cx
  781.   loop  @NextN
  782.  
  783.   mov   cx,9
  784. @NextA:
  785.   mov   bx,cx
  786.   dec   bx
  787.   add   bx,0B0h
  788.   mov   ah,byte ptr FMRegisters[bx]
  789.   and   ah,11011111b
  790.   mov   al,bl
  791.   call  OutCmd
  792.   loop  @NextA
  793.   mov   ah,byte ptr FMRegisters[0BDh]
  794.   and   ah,11100000b
  795.   mov   al,0BDh
  796.   call  OutCmd
  797. end; {QuitVoices}
  798.  
  799. procedure SetWaveForm(State : boolean); assembler;
  800.  
  801. var
  802.   i : byte;
  803.  
  804. asm {SetWaveForm}
  805.   mov   ah,State
  806.   and   ah,1
  807.   mov   WaveFormEnabled,ah
  808.   ror   ah,1
  809.   ror   ah,1
  810.   ror   ah,1
  811.   mov   al,1
  812.   call  OutCmd
  813. end; {SetWaveForm}
  814.  
  815. procedure AllKeyOff;
  816.  
  817. var
  818.   i : byte;
  819.  
  820. begin {AllKeyOff}
  821.   if CurrentFMMode=Melodic then
  822.     for i:=1 to 9 do
  823.       KeyOff(i)
  824.   else
  825.     for i:=1 to 11 do
  826.       KeyOff(i)
  827. end; {AllKeyOff}
  828.  
  829. procedure SetCSMMode(State : boolean); assembler;
  830.  
  831. asm {SetCSMMode}
  832.   call  AllKeyOff
  833.   mov   ah,State
  834.   and   ah,00000001b
  835.   mov   CSMModeEnabled,ah
  836.   ror   ah,1
  837.   mov   al,byte ptr FMRegisters[8]
  838.   and   al,01111111b
  839.   or    ah,al
  840.   mov   al,8
  841.   call  OutCmd
  842. end; {SetCSMMode}
  843.  
  844. procedure SetKBDSplit(State : boolean); assembler;
  845.  
  846. asm {SetKBDSplit}
  847.   mov   ah,State
  848.   and   ah,00000001b
  849.   mov   KBDSplitEnabled,ah
  850.   ror   ah,1
  851.   ror   ah,1
  852.   mov   al,byte ptr FMRegisters[8]
  853.   and   al,10111111b
  854.   or    ah,al
  855.   mov   al,8
  856.   call  OutCmd
  857. end; {SetKBDSplit}
  858.  
  859. procedure SetAMDepth(State : boolean); assembler;
  860.  
  861. asm {SetAMDepth}
  862.   mov   ah,State
  863.   and   ah,00000001b
  864.   mov   AMDepthEnabled,ah
  865.   ror   ah,1
  866.   mov   al,byte ptr FMRegisters[0BDh]
  867.   and   al,01111111b
  868.   or    ah,al
  869.   mov   al,0BDh
  870.   call  OutCmd
  871. end; {SetAMDepth}
  872.  
  873. procedure SetVIBDepth(State : boolean); assembler;
  874.  
  875. asm {SetVIBDepth}
  876.   mov   ah,State
  877.   and   ah,00000001b
  878.   mov   VIBDepthEnabled,ah
  879.   ror   ah,1
  880.   ror   ah,1
  881.   mov   al,byte ptr FMRegisters[0BDh]
  882.   and   al,10111111b
  883.   or    ah,al
  884.   mov   al,0BDh
  885.   call  OutCmd
  886. end; {SetVIBDepth}
  887.  
  888. procedure SetFMMode(FMMode : byte); assembler;
  889.  
  890. asm {SetFMMode}
  891.   call  QuitVoices
  892.   mov   al,FMMode
  893.   and   al,00000001b
  894.   mov   CurrentFMMode,al
  895.   shl   al,1
  896.   shl   al,1
  897.   shl   al,1
  898.   shl   al,1
  899.   shl   al,1                            {Shift bit to D5}
  900.   mov   ah,byte ptr FMRegisters[0BDh]
  901.   and   ah,11000000b
  902.   or    ah,al
  903.   mov   al,0BDh
  904.   call  OutCmd
  905. end; {SetFMMode}
  906.  
  907. procedure SetMelRhythm(State : boolean);
  908.  
  909. begin {SetMelRhythm}
  910.   MelRhythm := State
  911. end; {SetMelRhythm}
  912.  
  913. {* compatibility with CMF modes *}
  914.  
  915. procedure SetSC(Ofs, Data : byte); assembler;
  916.  
  917. asm {SetSC}
  918.   mov   ah,Data
  919.   mov   al,Ofs
  920.   add   al,020h
  921.   call  OutCmd
  922. end; {SetSC}
  923.  
  924. procedure SetSO(Ofs, Data : byte); assembler;
  925.  
  926. asm {SetSO}
  927.   mov   ah,Data
  928.   mov   al,Ofs
  929.   add   al,040h
  930.   call  OutCmd
  931. end; {SetSO}
  932.  
  933. procedure SetAD(Ofs, Data : byte); assembler;
  934.  
  935. asm {SetAD}
  936.   mov   ah,Data
  937.   mov   al,Ofs
  938.   add   al,060h
  939.   call  OutCmd
  940. end; {SetAD}
  941.  
  942. procedure SetSR(Ofs, Data : byte); assembler;
  943.  
  944. asm {SetSR}
  945.   mov   ah,Data
  946.   mov   al,Ofs
  947.   add   al,080h
  948.   call  OutCmd
  949. end; {SetSR}
  950.  
  951. procedure SetWS(Ofs, Data : byte); assembler;
  952.  
  953. asm {SetWS}
  954.   mov   ah,Data
  955.   mov   al,Ofs
  956.   add   al,0E0h
  957.   call  OutCmd
  958. end; {SetWS}
  959.  
  960. procedure SetFC(Ofs, Data : byte); assembler;
  961.  
  962. asm {SetFC}
  963.   mov   ah,Data
  964.   mov   al,Ofs
  965.   add   al,0C0h
  966.   call  OutCmd
  967. end; {SetFC}
  968.  
  969. function ModOfs(channel : byte) : byte;
  970.  
  971. begin {ModOfs}
  972.   case CurrentFMMode of
  973.     Melodic :
  974.       ModOfs := M_OpCell[channel+1,0];
  975.     Rhythmic:
  976.       if channel<6 then
  977.         ModOfs := R_OpCell[channel+1,0]
  978.       else
  979.         ModOfs := R_OpCell[channel-5,0]
  980.   end
  981. end; {ModOfs}
  982.  
  983. function CarOfs(channel : byte) : byte;
  984.  
  985. begin {CarOfs}
  986.   case CurrentFMMode of
  987.     Melodic :
  988.       CarOfs := M_OpCell[channel+1,1];
  989.     Rhythmic:
  990.       if channel<6 then
  991.         CarOfs := R_OpCell[channel+1,1]
  992.     else
  993.         CarOfs := R_OpCell[channel-5,1]
  994.   end
  995. end; {CarOfs}
  996.  
  997. {* end of compatibility with CMF modes *}
  998.  
  999. procedure ResetTimers; assembler;
  1000.  
  1001. asm {ResetTimers}
  1002.   mov   ah,60h
  1003.   mov   al,04h
  1004.   call  OutCmd                          {Mask T1 & T2}
  1005.  
  1006.   mov   ah,80h
  1007.   mov   al,04h
  1008.   call  OutCmd                          {Reset IRQ}
  1009. end; {ResetTimers}
  1010.  
  1011. procedure ResetRegisters; assembler;
  1012.  
  1013. asm {ResetRegisters}
  1014.   mov   cx,0F5h
  1015.  
  1016. @NextReg:
  1017.   mov   ax,cx
  1018.   call  OutCmd
  1019.   loop  @NextReg
  1020. end; {ResetRegisters}
  1021.  
  1022. procedure ResetVariables;
  1023.  
  1024. begin {ResetVariables}
  1025.   SetWaveForm(ON);
  1026.   SetCSMMode(OFF);
  1027.   SetKBDSplit(ON);
  1028.   SetAMDepth(OFF);
  1029.   SetVIBDepth(OFF)
  1030. end; {ResetVariables}
  1031.  
  1032. procedure ResetPitch; assembler;
  1033.  
  1034. asm {ResetPitch}
  1035.   mov   al,CurrentFMMode
  1036.   cmp   al,0
  1037.   jne   @Rhythm
  1038.  
  1039.   mov   cx,9
  1040.   mov   bx,57A0h
  1041.   mov   dx,01B0h
  1042.  
  1043. @NextVoice:
  1044.   mov   ax,bx
  1045.   call  OutCmd
  1046.   inc   bx
  1047.   mov   ax,dx
  1048.   call  OutCmd
  1049.   inc   dx
  1050.  
  1051.   loop  @NextVoice
  1052.   jmp   @RPExit
  1053.  
  1054. @Rhythm:
  1055.  
  1056.   mov   ax,57A0h                        {Voice 1}
  1057.   call  OutCmd
  1058.   mov   ax,11B0h
  1059.   call  OutCmd
  1060.   mov   ax,57A1h                        {Voice 2}
  1061.   call  OutCmd
  1062.   mov   ax,01B1h
  1063.   call  OutCmd
  1064.   mov   ax,57A2h                        {Voice 3}
  1065.   call  OutCmd
  1066.   mov   ax,01B2h
  1067.   call  OutCmd
  1068.   mov   ax,57A3h                        {Voice 4}
  1069.   call  OutCmd
  1070.   mov   ax,01B3h
  1071.   call  OutCmd
  1072.   mov   ax,57A4h                        {Voice 5}
  1073.   call  OutCmd
  1074.   mov   ax,01B4h
  1075.   call  OutCmd
  1076.   mov   ax,57A5h                        {Voice 6}
  1077.   call  OutCmd
  1078.   mov   ax,01B5h
  1079.   call  OutCmd
  1080.  
  1081.   mov   ax,57A6h                        {Bass drum}
  1082.   call  OutCmd
  1083.   mov   ax,09B6h                        {Warning!!! was : 01B6}
  1084.   call  OutCmd
  1085.  
  1086.   mov   ax,03A7h                        {Snare drum & Hi-Hat}
  1087.   call  OutCmd
  1088.   mov   ax,0AB7h
  1089.   call  OutCmd
  1090.  
  1091.   mov   ax,57A8h                        {Tom & Cymbal}
  1092.   call  OutCmd
  1093.   mov   ax,09B8h
  1094.   call  OutCmd
  1095.  
  1096. @RPExit:
  1097. end; {ResetPitch}
  1098.  
  1099. procedure ResetVoice(Voice:byte);
  1100.  
  1101. begin {ResetVoice}
  1102.   if (CurrentFMMode=Melodic) or (Voice<=6) then
  1103.     AssignVoice(Voice,InsData(Piano1))
  1104.   else
  1105.     case Voice of
  1106.       7 : AssignVoice(7,InsData(BDrum1));
  1107.       8 : AssignVoice(8,InsData(Snare1));
  1108.       9 : AssignVoice(9,InsData(Tom1));
  1109.       10: AssignVoice(10,InsData(Cymbal1));
  1110.       11: AssignVoice(11,InsData(HiHat1))
  1111.     end;
  1112. end; {ResetVoice}
  1113.  
  1114. procedure ResetSynth;
  1115.  
  1116. begin {ResetSynth}
  1117.   ResetVariables;
  1118.   AssignVoice(1,InsData(Piano1));
  1119.   AssignVoice(2,InsData(Piano1));
  1120.   AssignVoice(3,InsData(Piano1));
  1121.   AssignVoice(4,InsData(Piano1));
  1122.   AssignVoice(5,InsData(Piano1));
  1123.   AssignVoice(6,InsData(Piano1));
  1124.   if CurrentFMMode=Melodic then
  1125.     begin
  1126.       AssignVoice(7,InsData(Piano1));
  1127.       AssignVoice(8,InsData(Piano1));
  1128.       AssignVoice(9,InsData(Piano1));
  1129.     end
  1130.   else
  1131.     begin
  1132.       AssignVoice(7,InsData(BDrum1));
  1133.       AssignVoice(8,InsData(Snare1));
  1134.       AssignVoice(9,InsData(Tom1));
  1135.       AssignVoice(10,InsData(Cymbal1));
  1136.       AssignVoice(11,InsData(HiHat1))
  1137.     end;
  1138.   ResetPitch
  1139. end; {ResetSynth}
  1140.  
  1141. function FMStatus(voice : byte) : InsDataPtr;
  1142.  
  1143. begin {FMStatus}
  1144.   with TmpInsData do
  1145.     begin
  1146.       Mode := 0;
  1147.       PercVoice := 0;
  1148.       if (Voice in [7..11]) and (CurrentFMMode=Rhythmic) then
  1149.         begin
  1150.           Mode := 1;
  1151.           PercVoice := Voice-1
  1152.         end;
  1153.       with Op0 do
  1154.         begin
  1155.           FreqMult :=   (FMRegisters[$20+R_OpCell[Voice][0]] and $0F);
  1156.           KSR :=        (FMRegisters[$20+R_OpCell[Voice][0]] and $10) shr 4;
  1157.           EG :=         (FMRegisters[$20+R_OpCell[Voice][0]] and $20) shr 5;
  1158.           Vib :=        (FMRegisters[$20+R_OpCell[Voice][0]] and $40) shr 6;
  1159.           AM :=         (FMRegisters[$20+R_OpCell[Voice][0]] and $80) shr 7;
  1160.           Output :=     (FMRegisters[$40+R_OpCell[Voice][0]] and $3F);
  1161.           KSL :=        (FMRegisters[$40+R_OpCell[Voice][0]]) shr 6;
  1162.           Decay :=      (FMRegisters[$60+R_OpCell[Voice][0]] and $0F);
  1163.           Attack :=     (FMRegisters[$60+R_OpCell[Voice][0]]) shr 4;
  1164.           Release :=    (FMRegisters[$80+R_OpCell[Voice][0]] and $0F);
  1165.           SustLevel :=  (FMRegisters[$80+R_OpCell[Voice][0]]) shr 4;
  1166.           if (Mode=0) or (Voice<=7) then
  1167.             begin
  1168.               FM :=       (FMRegisters[$C0+Voice-1] and $01);
  1169.               FeedBack :=   (FMRegisters[$C0+Voice-1] and $0E) shr 1;
  1170.             end
  1171.           else
  1172.             begin
  1173.               FM := 0;
  1174.               Feedback := 0;
  1175.             end;
  1176.         end;
  1177.       Wave0 := (FMRegisters[$E0+R_OpCell[Voice][0]] and $03);
  1178.       if (Voice in [8..11]) and (CurrentFMMode=Rhythmic) then
  1179.         with Op1 do
  1180.           begin
  1181.             Attack    := 15;
  1182.             SustLevel := 15;
  1183.             Decay     := 15;
  1184.             Release   := 15;
  1185.             KSL       := 0;
  1186.             FreqMult  := 0;
  1187.             FeedBack  := 0;
  1188.             EG        := 0;
  1189.             Output    := 63;
  1190.             AM        := 0;
  1191.             Vib       := 0;
  1192.             KSR       := 0;
  1193.             FM        := 0;
  1194.             Wave1     := 0
  1195.           end
  1196.       else
  1197.         with Op1 do
  1198.            begin
  1199.             FreqMult  := (FMRegisters[$20+M_OpCell[Voice][1]] and $0F);
  1200.             KSR       := (FMRegisters[$20+M_OpCell[Voice][1]] and $10) shr 4;
  1201.             EG        := (FMRegisters[$20+M_OpCell[Voice][1]] and $20) shr 5;
  1202.             Vib       := (FMRegisters[$20+M_OpCell[Voice][1]] and $40) shr 6;
  1203.             AM        := (FMRegisters[$20+M_OpCell[Voice][1]] and $80) shr 7;
  1204.             Output    := (FMRegisters[$40+M_OpCell[Voice][1]] and $3F);
  1205.             KSL       := (FMRegisters[$40+M_OpCell[Voice][1]]) shr 6;
  1206.             Decay     := (FMRegisters[$60+M_OpCell[Voice][1]] and $0F);
  1207.             Attack    := (FMRegisters[$60+M_OpCell[Voice][1]]) shr 4;
  1208.             Release   := (FMRegisters[$80+M_OpCell[Voice][1]] and $0F);
  1209.             SustLevel := (FMRegisters[$80+M_OpCell[Voice][1]]) shr 4;
  1210.             FM        := 0;
  1211.             Feedback  := 0;
  1212.             Wave1     := (FMRegisters[$E0+M_OpCell[Voice][1]] and $03)
  1213.           end
  1214.     end;
  1215.   FMStatus := @TmpInsData
  1216. end; {FMStatus}
  1217.  
  1218. procedure FMInit(Base : word);
  1219.  
  1220. begin {FMInit}
  1221.   BaseReg := Base;
  1222.   Install := true;
  1223.   AdLibInstalled := IsAdLib;
  1224.   Install := false;
  1225.   if not(AdLibInstalled) then
  1226.     FMError := 1
  1227.   else
  1228.     begin
  1229.       FMError := 0;
  1230.       ResetRegisters;
  1231.       ResetTimers;
  1232.       SetFMMode(Rhythmic);
  1233.       SetMelRhythm(OFF);
  1234.       ResetSynth
  1235.     end
  1236. end; {FMInit}
  1237.  
  1238. function IsAdLib : boolean; assembler;
  1239.  
  1240. asm {IsAdLib}
  1241.   call  ResetTimers
  1242.  
  1243.   mov   dx,BaseReg
  1244.   in    al,dx                           {Read T1}
  1245.  
  1246.   push  ax                              {Save T1}
  1247.  
  1248.   mov   ah,0FFh
  1249.   mov   al,02h
  1250.   call  OutCmd                          {Set Timer 1 latch}
  1251.  
  1252.   mov   ah,21h
  1253.   mov   al,04h
  1254.   call  OutCmd                          {Unmask & start T1}
  1255.  
  1256.   mov   dx,BaseReg
  1257.   mov   cx,200
  1258. @Again:
  1259.   in    al,dx
  1260.   loop  @Again                          {100 uSec delay for timer-1 overflow}
  1261.                                         {al = T2}
  1262.  
  1263.   push  ax
  1264.   call  ResetTimers
  1265.  
  1266.   pop   bx                              {T2 in bl}
  1267.   pop   ax                              {T1 in al}
  1268.  
  1269.   and   bl,0E0h
  1270.   cmp   bl,0C0h
  1271.   jnz   @AdLibNotFound
  1272.  
  1273.   and   al,0E0h
  1274.   cmp   al,0
  1275.   jnz   @AdLibNotFound
  1276.  
  1277.   mov   ax,1                            {return true}
  1278.   jmp   @IsAdLibExit
  1279.  
  1280. @AdLibNotFound:
  1281.   xor   ax,ax                           {return false}
  1282.  
  1283. @IsAdLibExit:
  1284. end; {IsAdLib}
  1285.  
  1286. function FindBasePort : boolean;
  1287.  
  1288. const
  1289.   BasePort : array[1..9] of word = ($388,$318,$218,$228,$238,$248,$258,$268,$288);
  1290.  
  1291. var
  1292.   i : byte;
  1293.  
  1294. begin {FindBasePort}
  1295.   i := 1;
  1296.   repeat
  1297.     FMInit(BasePort[i]);
  1298.     inc(i)
  1299.   until (FMError=0) or (i>9);
  1300.   FindBasePort := FMError=0;
  1301. end; {FindBasePort}
  1302.  
  1303. function FindSBPBasePort : word;
  1304.  
  1305. const
  1306.   BasePort : array[1..2] of word = ($248,$228);
  1307.  
  1308. var
  1309.   i : byte;
  1310.   J,K : byte;
  1311.  
  1312. begin {FindSBPBasePort}
  1313.   i := 1;
  1314.   repeat
  1315.     FMInit(BasePort[i]);
  1316.     if FMError=0 then
  1317.       begin
  1318.         Port[BaseReg-4] := $06;
  1319.         J := Port[BaseReg-3];
  1320.  
  1321.         Port[BaseReg-4] := $06;
  1322.         Port[BaseReg-3] := $26;
  1323.  
  1324.         Port[BaseReg-4] := $06;
  1325.         K := Port[BaseReg-3];
  1326.  
  1327.         if K<>$37 then
  1328.           FMError := 8
  1329.         else
  1330.           Port[BaseReg-3] := J;
  1331.       end;
  1332.     inc(i)
  1333.   until (FMError=0) or (i>2);
  1334.   if FMError=0 then
  1335.     FindSBPBasePort := BaseReg
  1336.   else
  1337.     FindSBPBasePort := 0
  1338. end; {FindSBPBasePort}
  1339.  
  1340. begin {FM}
  1341.   FMError := 0;
  1342.   BaseReg := $0388;
  1343.   CurrentFMMode := Undefined
  1344. end. {FM}
  1345.